home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / toolssrc / Maine.sml < prev    next >
Encoding:
Text File  |  1995-10-19  |  3.2 KB  |  130 lines  |  [TEXT/Moml]
  1. (* Main.sml *)
  2.  
  3. open List BasicIO Nonstdio;
  4. open Miscsys Memory Fnlib Config Mixture Location Units Smlperv Rtvals Smltope;
  5.  
  6. val initialFiles = ref ([] : string list);
  7.  
  8. (* Initial loop *)
  9.  
  10. fun initial_loop () =
  11.   while true do
  12.     let in
  13.       msgFlush();
  14.       (case !initialFiles of
  15.            [] =>
  16.              raise Toplevel
  17.          | filename :: rest =>
  18.              (initialFiles := rest;
  19.               evalUse filename))
  20.       handle
  21.           Toplevel =>
  22.             (msgFlush();
  23.              raise EndOfFile)
  24.         | Interrupt =>
  25.             (msgIBlock 0;
  26.              msgPrompt "Interrupted."; msgEOL();
  27.              msgEBlock();
  28.              msgFlush();
  29.              raise EndOfFile)
  30.         | x =>
  31.            (msgFlush();
  32.             raise x)
  33.     end
  34. ;
  35.  
  36. (* Main loop *)
  37.  
  38. fun main_loop () =
  39.   while true do
  40.     let in
  41.       msgFlush();
  42.       outputc std_out toplevel_input_prompt;
  43.       flush_out std_out;
  44.       let val isLast = loadToplevelPhrase (!input_lexbuf) in
  45.         if isLast then raise EndOfFile else ()
  46.       end
  47.       handle
  48.           EndOfFile =>
  49.               (msgFlush(); BasicIO.exit 0)
  50.         | Toplevel =>
  51.             msgFlush()
  52.         | Interrupt =>
  53.             (msgIBlock 0;
  54.              msgPrompt "Interrupted.";
  55.              msgEOL(); msgEBlock(); msgFlush())
  56.         | x =>
  57.             (msgFlush();
  58.              raise x)
  59.     end
  60. ;
  61.  
  62. fun anonymous s =
  63.   initialFiles := !initialFiles @ [s]
  64. ;
  65.  
  66. fun set_stdlib p =
  67.   path_library := p;
  68. ;
  69.  
  70. fun add_include d =
  71.   load_path := !load_path @ [d]
  72. ;
  73.  
  74. fun perv_set set =
  75.   (preloadedUnits := lookup set preloadedUnitSets;
  76.    preopenedPreloadedUnits := lookup set preopenedPreloadedUnitSets)
  77.   handle Subscript =>
  78.     raise (Arg.Bad ("unknown preloaded unit set " ^ set))
  79. ;
  80.  
  81. fun main () =
  82. (
  83.   msgIBlock 0;
  84.   msgString "Moscow ML version 1.31 (15 October 1995)";
  85.   msgEOL();
  86.   msgString "Mangled by e & MacMake (19 October 1995)";
  87.   msgEOL();
  88.   msgString "Enter `quit();' to quit.";
  89.   msgEOL();
  90.   msgEBlock();
  91.   msgFlush();
  92.   let in
  93.     preloadedUnits := lookup "default" preloadedUnitSets;
  94.     preopenedPreloadedUnits := lookup "default" preopenedPreloadedUnitSets;
  95.     load_path := [];
  96.     toplevel := true;
  97.     Arg.parse [("-stdlib", Arg.String set_stdlib),
  98.                ("-I", Arg.String add_include),
  99.                ("-include", Arg.String add_include),
  100.                ("-P", Arg.String perv_set),
  101.                ("-perv", Arg.String perv_set)]
  102.       anonymous;
  103.     if !path_library <> "" then
  104.       load_path := !load_path @ [!path_library]
  105.     else ();
  106.     resetGlobalDynEnv();
  107.     resetSMLTopDynEnv();
  108.     initPervasiveEnvironments();
  109.     setGlobalVal 16 (Obj.repr true); (* 16: cf ../runtime/globals.h *)
  110.     startCompilingUnit "Top";
  111.     app evalLoad (!preloadedUnits);
  112.     initInitialEnvironments();
  113.     execToplevelOpen nilLocation "Meta";
  114.     Miscsys.catch_interrupt true;
  115.     input_lexbuf := Compiler.createLexerStream std_in;
  116.     (initial_loop() handle EndOfFile => ());
  117.     main_loop()
  118.   end
  119.   handle
  120.       Toplevel =>
  121.         (msgFlush(); BasicIO.exit 2)
  122.     | Impossible msg =>
  123.         (msgIBlock 0;
  124.          errPrompt "Internal error: "; msgString msg;
  125.          msgEOL(); msgEBlock(); msgFlush();
  126.          BasicIO.exit 4)
  127. );
  128.  
  129. val () = Printexc.f main ();
  130.